Aminet 41/Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso/Aminet/gfx/edit/AmiCAD_2.06.lha/AmiCAD/ARexx/TirerTraits.AmiCAD

Text File | 2000-04-14 | 4KB | 209 lines

/* Décalage et alignement des extrémités d'un ensemble de lignes */
/* Version 1.00 13/01/99 */
/* Version 1.01 06/02/99, Ajout UNLOCK */
/* Version 1.02 16/03/99, modif macro LIGNE */
/* Version 1.03 22/09/99, correction bug si annulation GETPOINT (ajout UNLOCK) */
/* Version 1.04 14/04/00, adaptation version 2.05 */
/* $VER: 1.04 (© R.Florac, 14/04/00) */
options results

signal on error
signal on syntax

'DEF LIGNE(P)=P&0X07FFF'
'DEF COLONNE(P)=P>>15'
'LOCK:SELECT("Extrémité à déplacer?"+CHR(10)+"Gauche"+CHR(10)+"Haut"+CHR(10)+"Droite"+CHR(10)+"Bas")'
d=result
select
    when d=1 then do
    'GETPOINT("Cliquez sur la colonne de destination")'; p=result
    if p<0 then do
        'UNLOCK'
        exit
    end
    'COLONNE('p')'; col=result
    'SAVEALL:FIRSTSEL'; o=result
    do while o>0
        mode=mode_ligne(o)
        if mode~=-1000 then do
        o = retracer_gauche(o,col,mode)
        end
        else do
        'NEXTSEL('o')'; o=result
        end
    end
    end
    when d=2 then do
    'GETPOINT("Cliquez sur la ligne de destination")'; p=result
    if p<0 then do
        'UNLOCK'
        exit
    end
    'LIGNE('p')'; ligne=result
    'SAVEALL:FIRSTSEL'; o=result
    do while o>0
        mode=mode_ligne(o)
        if mode~=-1000 then do
        o = retracer_haut(o,ligne,mode)
        end
        else do
        'NEXTSEL('o')'; o=result
        end
    end
    end
    when d=3 then do
    'GETPOINT("Cliquez sur la colonne de destination")'; p=result
    if p<0 then do
        'UNLOCK'
        exit
    end
    'COLONNE('p')'; col=result
    'SAVEALL:FIRSTSEL'; o=result
    do while o>0
        mode=mode_ligne(o)
        if mode~=-1000 then do
        o = retracer_droite(o,col,mode)
        end
        else do
        'NEXTSEL('o')'; o=result
        end
    end
    end
    when d=4 then do
    'GETPOINT("Cliquez sur la ligne de destination")'; p=result
    if p<0 then do
        'UNLOCK'
        exit
    end
    'LIGNE('p')'; ligne=result
    'SAVEALL:FIRSTSEL'; o=result
    do while o>0
        mode=mode_ligne(o)
        if mode~=-1000 then do
        o = retracer_bas(o,ligne,mode)
        end
        else do
        'NEXTSEL('o')'; o=result
        end
    end
    end
    otherwise nop
end
'UNLOCK'
exit

mode_ligne: procedure
    parse arg o
    mode=-1000
    'TYPE('o')'
    select
    when result=2 then mode=1   /* fil */
    when result=15 then mode=2  /* ligne double */
    when result=9 then mode=3   /* bus */
    when result=8 then mode=0   /* pointillés */
    when result=21 then do        /* ligne spéciale */
        'PENWIDTH('o',-10000)'
        mode=0-result
    end
    otherwise nop
    end
    return mode

minima: procedure
    parse arg v1,v2
    if v1<v2 then return v1
    return v2
end

maxima: procedure
    parse arg v1,v2
    if v1>v2 then return v1
    return v2
end

retracer_gauche: procedure
    parse arg o,col,mode
    'COORDS('o')'
    PARSE VAR result x0 ',' y0 ',' x1 ',' y1
    xg=minima(x0,x1)
    if x0=x1 then x1=col
    if xg=x0 then do
    x2=x1; y2=y1;
    end
    else do
    x2=x0; y2=y0; y0=y1
    end
    'DELETE('o'):DRAWMODE('mode'):DRAW('col','y0','x2','y2')'; no=result
    if no=o then o=0
    else do
    'NEXTSEL('o-1')'; o=result
    end
    return o

retracer_haut: procedure
    parse arg o,ligne,mode
    'COORDS('o')'
    PARSE VAR result x0 ',' y0 ',' x1 ',' y1
    yh=minima(y0,y1)
    if y0=y1 then y1=ligne
    if yh=y0 then do
    y2=y1; x2=x1;
    end
    else do
    y2=y0; x2=x0; x0=x1
    end
    'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
    if no=o then o=0
    else do
    'NEXTSEL('o-1')'; o=result
    end
    return o

retracer_droite: procedure
    parse arg o,col,mode
    'COORDS('o')'
    PARSE VAR result x0 ',' y0 ',' x1 ',' y1
    xd=maxima(x0,x1)
    if x0=x1 then x0=col
    if xd=x1 then do
    x2=x0; y2=y0; y0=y1
    end
    else do
    x2=x1; y2=y1
    end
    'DELETE('o'):DRAWMODE('mode'):DRAW('x2','y2','col','y0')'; no=result
    if no=o then o=0
    else do
    'NEXTSEL('o-1')'; o=result
    end
    return o

retracer_bas: procedure
    parse arg o,ligne,mode
    'COORDS('o')'
    PARSE VAR result x0 ',' y0 ',' x1 ',' y1
    yb=maxima(y0,y1)
    if y0=y1 then y1=ligne
    if yb=y0 then do
    y2=y1; x2=x1;
    end
    else do
    y2=y0; x2=x0; x0=x1
    end
    'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
    if no=o then o=0
    else do
    'NEXTSEL('o-1')'; o=result
    end
    return o

/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
exit

error:
'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK'
exit